home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Demos / high_interrupt < prev    next >
Encoding:
Text File  |  1991-08-14  |  3.9 KB  |  147 lines
  1. \ JForth - Host Dependant Interrupt based 60 Hz timer.
  2. \
  3. \ Use a Vertical Blanking Interrupt Server
  4. \ to increment a variable every 1/60th of a second.
  5. \ Do this in high level to show what must be done
  6. \ to do high level Forth interrupts.
  7. \
  8. \ The interrupt routine must setup A3-A6 to what
  9. \ JForth needs.  A6 must point to a stack that is
  10. \ used only be the interrupt server.  The
  11. \ values for these registers are contained in an array
  12. \ whose address is passed through the interrupt structure.
  13. \
  14. \ If you call HIGH LEVEL Forth words from an Interupt
  15. \ you must be VERY CAREFUL not to affect any other Forth
  16. \ code.  Do not call words that use temporary storage
  17. \ variables.  Do not do anything that takes too long
  18. \ or that does any I/O.  No EMIT or ." or KEY , etc.
  19. \
  20. \ Be sure to turn off the clock before
  21. \ forgetting this code.
  22. \
  23. \ This code was extracted from HMSL and modified.
  24. \ HMSL is the Hierarchical Music Specification Language
  25. \ from the Mills College Center for Contemporary Music
  26. \
  27. \ Author: Phil Burk
  28. \ Copyright 1988 Phil Burk
  29. \
  30. \ MOD: PLB 5/12/89 Fix A6-A5 mixup when saving and restoring
  31. \      registers in interrupt server.
  32.  
  33. include? interrupt ji:exec/interrupts.j
  34. include? INTB_VERTB ji:hardware/intbits.j
  35.  
  36. ANEW TASK-AJF_RTC
  37. decimal
  38. variable VERTBINTR
  39. variable TIME-COUNT
  40.  
  41. \ See the ROM Kernal Manual for a full description.
  42. : ADDINTSERVER() ( type interrupt -- )
  43.     >abs
  44.     call exec_lib addintserver drop
  45. ;
  46.  
  47. : REMINTSERVER() ( type interrupt -- )
  48.     >abs
  49.     call exec_lib remintserver drop
  50. ;
  51.  
  52. \ Create special stack just for interupt.
  53. CREATE INT-STACK 256 allot
  54. 4 allot    \ extra just for protection from underflow
  55. : TOP-INT-STACK int-staCK 256 + ;
  56.  
  57.  
  58. \ Create memory area for holding A4, A5 and A6
  59. 4 ARRAY AREGS-HOLDER
  60.  
  61. ASM GET.A3A4A5 ( -- A3 A4 A5 , push A4 and A5 onto stack )
  62.     MOVE.L     TOS,-(A6)
  63.     MOVE.L     A3,-(A6)
  64.     MOVE.L     A4,-(A6)
  65.     MOVE.L     A5,TOS
  66.     RTS
  67. END-CODE
  68.  
  69. : SETUP.AREGS-HOLDER  ( -- , setup image of A registers)
  70.     get.A3a4a5
  71.     2 aregs-holder !  ( A5 = User Pointer )
  72.     1 aregs-holder !  ( A4 = Base of JForth )
  73.     0 aregs-holder !  ( A3 = Base + 64K )
  74.     top-int-stack >abs 3 aregs-holder !  ( data stack )
  75. ;
  76.  
  77. : INCR.TIMER  ( -- , high level word to increment timer )
  78.     1 time-count +!
  79. ;
  80.  
  81. : TIME.INT.SERVER1 ( -- , called when vertical blanking occurs )
  82. \ Low Level version.
  83. \ The manual implies that A1 points to the is_data member.
  84. \ I found through experimentation that A1 actually contains
  85. \ the contents of is_data.
  86.     [  ( lay down code to avoid loading assembler )
  87.     $ 5291 w,   \ addq.l    #1,(a1)       ( increment counter )
  88.     $ 7000 w,   \ moveq.l   #0,d0         ( continue chain )
  89.     ]
  90. ;
  91.  
  92. ASM TIME.INT.SERVER2  ( -- )
  93. \ This is a version of TIME.INT.SERVER that calls
  94. \ HIGH LEVEL Forth code to do its thing.
  95.     MOVEM.L    D2-D7/A2-A6,-(A7)  \ Save non scratch registers.
  96. \ A1 points to the image in memory of what should be in A3,A4,A5,A6
  97.     MOVEM.L    (A1)+,A3-A6        \ Setup Forth registers
  98.     CALLCFA    INCR.TIMER         \ Call High Level
  99.     MOVEM.L    (A7)+,D2-D7/A2-A6
  100.     MOVEQ.L    #0,D0
  101.     RTS
  102. END-CODE
  103.  
  104. : CLOCK.INIT  ( -- , setup interrupt)
  105.     0 time-count !
  106.     setup.aregs-holder
  107.     vertbintr @ 0=  ( make sure not done twice )
  108.     IF
  109.         MEMF_PUBLIC sizeof() interrupt allocblock ?dup
  110.         IF
  111.             dup>r vertbintr !  ( save for TERM )
  112. \ Set values in structure.
  113.             NT_INTERRUPT r@ .. is_node ..! ln_type
  114.             -60  r@ .. is_node ..! ln_pri
  115.             0" VertB Timer" >abs r@ .. is_node ..! ln_name
  116.             0 aregs-holder >abs r@ ..! is_data
  117.             ' time.int.server2 >abs r@ ..! is_code
  118. \
  119. \ Add to EXEC List of Interrupt Servers for VERTB.
  120.             INTB_VERTB r> addintserver()
  121.         ELSE
  122.             ." TIME.INT.INIT - Not enough space for timer interrupt!" cr
  123.             abort
  124.         THEN
  125.     THEN
  126. ;
  127.  
  128. : CLOCK.TERM ( -- , remove and free timer interrupt )
  129.     vertbintr @ ?dup
  130.     IF  INTB_VERTB over remintserver()
  131.         freeblock
  132.         0 vertbintr !
  133.     THEN
  134. ;
  135.  
  136. : TIME@  ( -- current_time )
  137.     time-count @
  138. ;
  139.  
  140. : TEST ( -- , test high level interrupt )
  141.     clock.init
  142.     BEGIN time@ . cr
  143.         ?terminal
  144.     UNTIL
  145.     clock.term
  146. ;
  147.